home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / UNIXTOOL / GNU / PERL / PERL5SRC.ZIP / !Perl / c / acorn next >
Encoding:
Text File  |  1995-07-03  |  12.2 KB  |  672 lines
  1. /* $Header: archimedes.c,v 3.0.1.1 90/03/27 16:10:41 lwall Locked $
  2.  *
  3.  *    (C) Copyright 1989, 1990 Paul Moore.
  4.  *
  5.  *    You may distribute under the terms of the GNU General Public License
  6.  *    as specified in the README file that comes with the perl 3.0 kit.
  7.  *
  8.  * $Log:    archimedes.c,v $
  9.  * Revision 3.0.1.1  90/03/27  16:10:41  lwall
  10.  * patch16: MSDOS support
  11.  *
  12.  * Revision 1.1  90/03/18  20:32:01  dds
  13.  * Initial revision
  14.  *
  15.  */
  16.  
  17. /*
  18.  * Various Unix compatibility functions for Archimedes RISC OS.
  19.  * This file is basically the same as Paul Moore's one for the original RISC OS
  20.  * port of Perl 3. Some changes have been made to bring it up to date with Perl 5's
  21.  * way of doing things. There are also some extra functions LT - June 1995
  22.  */
  23.  
  24. #include <limits.h>
  25. #include <time.h>
  26. #include "kernel.h"
  27. #include "swis.h"
  28.  
  29. #include "EXTERN.h"
  30. #include "perl.h"
  31.  
  32. #undef fopen    /* fopen was redefined to my_fopen in perl.h but we don't want that here */
  33.  
  34. /* I'm not sure what the equivalents of these are in Perl 5 so I've just redefined
  35. them here for the moment. Possibly the Error[1] array in perl.h is the same as err_no */
  36.  
  37. char err_mess[255];            /* Last OS error string */
  38. int err_no;                /* Last OS error number - just use errno ? */
  39.  
  40. int h_errno = 0;
  41.  
  42. /*
  43.  * Save the last OS error return value
  44.  */
  45. void
  46. save_err (void)
  47. {
  48.     _kernel_oserror *err = _kernel_last_oserror();
  49.  
  50.     if (err)
  51.     {
  52.         err_no = err->errnum;
  53.         strcpy(err_mess, err->errmess);
  54.     }
  55.     else
  56.     {
  57.         err_no = 0;
  58.         strcpy(err_mess, "");
  59.     }
  60. }
  61.  
  62. /*
  63.  * Sleep function.
  64.  */
  65. void
  66. sleep(unsigned len)
  67. {
  68.     time_t end;
  69.  
  70.     end = time((time_t *)0) + len;
  71.     while (time((time_t *)0) < end)
  72.         ;
  73. }
  74.  
  75. /*
  76.  * Make and remove directories
  77.  */
  78. int
  79. mkdir(char *dir)
  80. {
  81.     int retval = 0;
  82.     int type;
  83.     _kernel_osfile_block blk;
  84.  
  85.     if ((type = _kernel_osfile(17,dir,&blk)) != 0)
  86.     {
  87.         err_no = 215;
  88.         sprintf(err_mess, "%s '%s' already exists",
  89.             type == 1 ? "File" : "Directory", dir);
  90.         retval = -1;
  91.     }
  92.  
  93.     blk.start = 0;
  94.     if (_kernel_osfile(8,dir,&blk) == _kernel_ERROR)
  95.     {
  96.         retval = -1;
  97.         save_err();
  98.     }
  99.  
  100.     return retval;
  101. }
  102.  
  103. int
  104. rmdir(char *dir)
  105. {
  106.     int retval = 0;
  107.     int type;
  108.     _kernel_osfile_block blk;
  109.  
  110.     /* Check that it's a directory */
  111.     if ((type = _kernel_osfile(17,dir,&blk)) != 2)
  112.     {
  113.         blk.load = type;
  114.         _kernel_osfile(19,dir,&blk);
  115.         retval = -1;
  116.     }
  117.     else if (_kernel_osfile(6,dir,&blk) == _kernel_ERROR)
  118.     {
  119.         retval = -1;
  120.     }
  121.  
  122.     if (retval == -1)
  123.         save_err();
  124.  
  125.     return retval;
  126. }
  127.  
  128. int
  129. unlink(char *file)
  130. {
  131.     int retval = 0;
  132.     _kernel_osfile_block blk;
  133.  
  134.     if (_kernel_osfile(6,file,&blk) == _kernel_ERROR)
  135.     {
  136.         save_err();
  137.         retval = -1;
  138.     }
  139.  
  140.     return retval;
  141. }
  142.  
  143. /*
  144.  * Set the timestamp for a file
  145.  */
  146. void
  147. stamp (char *file)
  148. {
  149.     _kernel_osfile_block blk;
  150.  
  151.     _kernel_osfile(9,file,&blk);
  152. }
  153.  
  154. /*
  155.  * Set environment variables
  156.  */
  157. void
  158. my_setenv(char *var, char *val)
  159. {
  160.     if (val)
  161.         _kernel_setenv(var,val);
  162.     else
  163.     {
  164.         _kernel_swi_regs regs;
  165.  
  166.         regs.r[0] = (int)var;
  167.         regs.r[1] = 0;
  168.         regs.r[2] = -1;
  169.         regs.r[3] = 0;
  170.         regs.r[4] = 0;
  171.  
  172.         _kernel_swi(OS_SetVarVal,®s,®s);
  173.     }
  174. }
  175.  
  176. /*
  177.  * The following code is based on the do_exec and do_aexec functions
  178.  * in file doio.c
  179.  */
  180. int
  181. do_aspawn(SV *really,SV **mark, SV **sp)
  182. {
  183.     return exec_cmdv(0, sp);
  184. }
  185.  
  186. int
  187. do_spawn(char *cmd)
  188. {
  189.     register SV *str;
  190.     register int status;
  191.  
  192.     _kernel_setenv("Sys$ReturnCode","0");
  193.  
  194.     if (*cmd == '\0')
  195.     return 0;
  196.  
  197. /*    str = newSVpv("Call:",5);
  198.     sv_catpv(str,cmd); */
  199.     status = system(cmd);
  200. /*    sv_free(str); */
  201.  
  202.     if (status == _kernel_ERROR)
  203.     save_err();
  204.  
  205.     return status;
  206. }
  207.  
  208. /*
  209.  * Generic exec- or spawn-type command execution.
  210.  */
  211. int
  212. exec_cmdv(int chain,SV *arglast)
  213. {
  214.     register SV **st = AvARRAY(stack);
  215.     register int sp = SvIV(&arglast[1]);
  216.     register int items = SvIV(&arglast[2]) - sp;
  217.     register char *a;
  218.     register char *arg;
  219.     SV *tmps;
  220.     int quotes;
  221.     int status = 0;
  222.     STRLEN len;
  223.  
  224.     if (items) {
  225.     st += ++sp;
  226.  
  227.     /* First, insert "Call:" */
  228.     tmps = newSVpv("Call:", 5);
  229.  
  230.     /* Now add the command name */
  231.     sv_catsv(tmps,*st);
  232.  
  233.     /* Now add each argument in turn */
  234.     for (--items, ++st; items > 0; --items, ++st) {
  235.         if (!*st)
  236.         continue;
  237.  
  238.         /* Separate with spaces */
  239.         sv_catpvn(tmps, " ", 1);
  240.  
  241.         arg = SvPV(*st,len);
  242.  
  243.         /* Do we need to quote this arg? */
  244.         quotes = (strchr(arg,'"') || strchr(arg,' ') || strchr(arg,'\t'));
  245.  
  246.         if (!quotes)
  247.         sv_catsv(tmps, *st);
  248.         else {
  249.         sv_catpvn(tmps, "\"", 1);
  250.  
  251.         /* Add the argument string, backslashing " and \ */
  252.         while ((a = strpbrk(arg,"\"\\")) != Nullch) {
  253.             sv_catpvn(tmps, arg, a - arg);
  254.             sv_catpvn(tmps, "\\", 1);
  255.             sv_catpvn(tmps, a, 1);
  256.             arg = a + 1;
  257.         }
  258.  
  259.         sv_catpv(tmps, arg);
  260.         sv_catpvn(tmps, "\"", 1);
  261.         }
  262.     }
  263.  
  264.     _kernel_setenv("Sys$ReturnCode","0");
  265.     status = system(SvPV(tmps,len));
  266.  
  267.     sv_free(tmps);
  268.  
  269.     if (status == _kernel_ERROR)
  270.         save_err();
  271.     else if (chain)
  272.         exit(0);
  273.     }
  274.  
  275.     return status;
  276. }
  277.  
  278. /*
  279.  * Execute a new command, based on an argv array
  280.  */
  281. void
  282. execv(cmd,argv)
  283. char *cmd;
  284. char **argv;
  285. {
  286.     register char *a;
  287.     register char *arg;
  288.     SV *tmps;
  289.     STRLEN len;
  290.     int quotes;
  291.     int result;
  292.  
  293.     /* First, insert "Call:" */
  294.     tmps = newSVpv("Call:", 5);
  295.  
  296.     /* Now add the command name */
  297.     sv_catpv(tmps, cmd);
  298.  
  299.     /* Now add each argument in turn */
  300.     for (++argv; *argv; ++argv)
  301.     {
  302.     if (!**argv)
  303.         continue;
  304.  
  305.     /* Separate with spaces */
  306.     sv_catpvn(tmps, " ", 1);
  307.  
  308.     arg = *argv;
  309.  
  310.     /* Do we need to quote this arg? */
  311.     quotes = (strchr(arg,'"') || strchr(arg,' ') || strchr(arg,'\t'));
  312.  
  313.     if (!quotes)
  314.         sv_catpv(tmps, arg);
  315.     else {
  316.         sv_catpvn(tmps, "\"", 1);
  317.  
  318.         /* Add the argument string, backslashing " and \ */
  319.         while ((a = strpbrk(arg,"\"\\")) != Nullch) {
  320.         sv_catpvn(tmps, arg, a - arg);
  321.         sv_catpvn(tmps, "\\", 1);
  322.         sv_catpvn(tmps, a, 1);
  323.         arg = a + 1;
  324.         }
  325.  
  326.         sv_catpv(tmps, arg);
  327.         sv_catpvn(tmps, "\"", 1);
  328.     }
  329.     }
  330.  
  331.     _kernel_setenv("Sys$ReturnCode","0");
  332.  
  333.     result = system(SvPV(tmps,len));
  334.     sv_free(tmps);
  335.  
  336.     if (result != _kernel_ERROR)
  337.     exit(0);
  338.     else
  339.     save_err();
  340. }
  341.  
  342. #define SECS1970 2208988800.0 /* Number of seconds from 1/1/1900 to 1/1/1970 */
  343.  
  344. /* Needs fixed */
  345. int fstat(int fd, struct stat *buf)
  346. {
  347.     buf->st_type = 0;
  348.     buf->st_load = 0;
  349.     buf->st_exec = 0;
  350.     buf->st_length = 0;
  351.     buf->st_attr = 0;
  352.     buf->st_ftype = -1;
  353.     buf->st_time = 0.0;
  354.     buf->st_utime = 0;
  355.  
  356. }
  357. /*
  358.  * Get a file's catalogue information
  359.  */
  360. int
  361. stat(char *file, struct stat *buf)
  362. {
  363.     int res;
  364.     _kernel_osfile_block blk;
  365.  
  366.     res = _kernel_osfile(5,file,&blk);
  367.  
  368.     if (res == _kernel_ERROR || res == 0)
  369.         return -1;
  370.  
  371.     buf->st_type = res;
  372.     buf->st_load = blk.load;
  373.     buf->st_exec = blk.exec;
  374.     buf->st_length = blk.start;
  375.     buf->st_attr = blk.end;
  376.  
  377.     if ((blk.load & 0xFFF00000) != 0xFFF00000)
  378.     {
  379.         buf->st_ftype = -1;
  380.         buf->st_time = 0.0;
  381.         buf->st_utime = 0;
  382.     }
  383.     else
  384.     {
  385.         double n;
  386.         buf->st_ftype = ((blk.load >> 8) & 0xFFF);
  387.         n = (double)((unsigned)(blk.load & 0xFF));
  388.         n *= 4294967296.0;    /* 2^32 */
  389.         n += (double)((unsigned)blk.exec);
  390.         buf->st_time = n;
  391.         n /= 100.0;
  392.         n -= SECS1970;
  393.  
  394.         if (n < 0.0)
  395.         {
  396.             n = 0.0;
  397.             if (dowarn)
  398.                 warn("Timestamp too small in stat (%s): set to %d\n",
  399.                     file, n);
  400.         }
  401.         else if (n > (double)UINT_MAX)
  402.         {
  403.             n = (double)UINT_MAX;
  404.             if (dowarn)
  405.                 warn("Timestamp too large in stat (%s): set to %d\n",
  406.                     file, n);
  407.         }
  408.  
  409.         buf->st_utime = (time_t)n;
  410.     }
  411.  
  412.     return 0;
  413. }
  414.  
  415. /*
  416.  * Scan through the OS variables selected by a pattern
  417.  */
  418. char *
  419. getenvar (char *pat, char **val)
  420. {
  421.     static char buffer[255];
  422.     static char *pattern;
  423.     static char *name_ptr;
  424.     _kernel_swi_regs regs;
  425.  
  426.     if (pat)
  427.     {
  428.         pattern = pat;
  429.         name_ptr = 0;
  430.     }
  431.  
  432.     regs.r[0] = (int)pattern;
  433.     regs.r[1] = (int)buffer;
  434.     regs.r[2] = 255;
  435.     regs.r[3] = (int)name_ptr;
  436.     regs.r[4] = 3;
  437.  
  438.     if (_kernel_swi(OS_ReadVarVal,®s,®s))
  439.         return 0;
  440.  
  441.     name_ptr = (char *)regs.r[3];
  442.     buffer[regs.r[2]] = '\0';
  443.  
  444.     *val = buffer;
  445.     return name_ptr;
  446. }
  447.  
  448.  
  449. /*
  450.  * Get the program start time (as a double)
  451.  */
  452. void os_starttime (double *dp)
  453. {
  454.     int i;
  455.     double tmp;
  456.     unsigned char *time;
  457.  
  458.     _kernel_swi_regs regs;
  459.     _kernel_oserror *err = _kernel_swi(OS_GetEnv, ®s, ®s);
  460.  
  461.     if (err)
  462.     {
  463.         err_no = err->errnum;
  464.         strcpy(err_mess, err->errmess);
  465.         *dp = 0.0;
  466.         return;
  467.     }
  468.  
  469.     time = (unsigned char *) regs.r[2];
  470.     tmp = 0.0;
  471.  
  472.     for (i = 4; i >= 0; --i)
  473.     {
  474.         tmp *= 256.0;
  475.         tmp += (double)(time[i]);
  476.     }
  477.  
  478.     *dp = tmp;
  479. }
  480.  
  481. /* Rename a file. If a simple OS rename fails, the file is copied.
  482.  * This allows renames across filing system boundaries.
  483.  * If the destination filename exists, the function deletes it (even
  484.  * if locked) first.
  485.  * This function does its best to be totally paranoid about errors, and
  486.  * returns failure if the rename does not work.
  487.  * Returns 0 on success, 1 on failure.
  488.  */
  489. int frename(const char *old, const char *new)
  490. {
  491.     register int result;
  492.     register int n;
  493.     FILE *in, *out;
  494.     _kernel_osfile_block blk;
  495.     char buf[BUFSIZ];
  496.  
  497.     /* Check the new file. If it exists, and is not a directory,
  498.      * unlock it (if necessary) and delete it.
  499.      */
  500.     result = _kernel_osfile (17, new, &blk);
  501.  
  502.     /* If the file is a directory, or an error occurred, return failure */
  503.     if (result == 2 || result == _kernel_ERROR)
  504.         return 1;
  505.  
  506.     /* If the file exists and is locked, unlock it */
  507.     if (result == 1 && (blk.end & 0x0008) != 0)
  508.     {
  509.         blk.end &= ~0x0008;
  510.         if (_kernel_osfile(4, new, &blk) == _kernel_ERROR)
  511.             return 1;
  512.     }
  513.  
  514.     /* If the file exists, delete it */
  515.     if (result == 1 && _kernel_osfile(6, new, &blk) == _kernel_ERROR)
  516.         return 1;
  517.  
  518.     /* Now try a simple OS rename */
  519.     if (rename(old, new) == 0)
  520.         return 0;
  521.  
  522.     /* No luck. Get the old file attributes (to ensure that it exists,
  523.      * and is not locked, and for later copying to the new file).
  524.      */
  525.     result = _kernel_osfile (17, old, &blk);
  526.  
  527.     /* If the file is not a simple file, or an error occurred,
  528.      * or the file is locked, return failure.
  529.      */
  530.     if (result != 1 || (blk.end & 0x0008) != 0)
  531.         return 1;
  532.  
  533.     /* Now prepare to copy the file */
  534.     if ((in = fopen(old, "rb")) == NULL)
  535.         return 1;
  536.  
  537.     if ((out = fopen(new, "wb")) == NULL)
  538.     {
  539.         fclose(in);
  540.         return 1;
  541.     }
  542.  
  543.     /* Copy the file */
  544.     while (!feof(in))
  545.     {
  546.         n = fread(buf, 1, BUFSIZ, in);
  547.         if (ferror(in) || fwrite(buf, 1, n, out) != n)
  548.         {
  549.             fclose(in);
  550.             fclose(out);
  551.             remove(new);
  552.             return 1;
  553.         }
  554.     }
  555.  
  556.     if (ferror(in) || fclose(in) == EOF || ferror(out) || fclose(out) == EOF)
  557.     {
  558.         remove(new);
  559.         return 1;
  560.     }
  561.  
  562.     /* Now copy the file attributes across, and delete the old
  563.      * file. Don't worry about errors - they're not too serious,
  564.      * and it's too late to do much anyway.
  565.      */
  566.     _kernel_osfile(1, new, &blk);
  567.     _kernel_osfile(6, old, &blk);
  568.  
  569.     return 0;
  570. }
  571.  
  572. int fileno(FILE *file)
  573. {
  574.     return(file->__file);
  575. }
  576.  
  577. FILE *fdopen(int fd, char *mode)
  578. {
  579.     /* What to do here - about sockets etc */
  580.     char filename[40];
  581.     sprintf(filename,"<Wimp$ScrapDir>.fd%d%s\0",fd,mode);
  582.     printf("Opening %s\n via fdopen",filename);
  583.     return(fopen(filename,mode));
  584. }
  585.  
  586. int chmod(const char *path, unsigned int mode)
  587. {
  588.     return(1);
  589. }
  590.  
  591. FILE *warn_fopen(char *name,char *mode)
  592. {
  593.     FILE *file;
  594.     static int test = -1;
  595.  
  596.     file = fopen(name,mode);
  597.     if(test < 0)
  598.         test = (int)getenv("PERLTEST");
  599.     if(test)
  600.         printf("fopen %s %s\n",name,(file ? " ":" -- Failed"));
  601.     return(file);
  602. }
  603.  
  604. FILE *my_fopen(char *name, char *mode)
  605. {
  606.     register FILE *file;
  607.     char myname[64];
  608.     char newname[64];
  609.  
  610.     strcpy(myname,name);
  611.  
  612.     file = warn_fopen(myname,mode);
  613.  
  614.     if(!file)
  615.     {
  616.         if(suffix_swap(myname))
  617.         {
  618.             file = warn_fopen(myname,mode);
  619.             if(!file && mode[0] == 'r')
  620.             {
  621.         /* It is a perl file so try the script directory as a last resort. *
  622.          * This is a quick fix until I work out why it isn't searching automatically */
  623.                  strcpy(newname,"<PerlScript$Dir>.");
  624.                  if(strlen(myname) < 20)
  625.                      strcat(newname,myname);
  626.                  file = warn_fopen(newname,"r");
  627.                  if(!file)    /* One last try - skip the pl.*/
  628.                  {
  629.                      strcpy(&newname[17],&myname[3]);
  630.                      file = warn_fopen(newname,"r");
  631.                  }
  632.              }
  633.         }
  634.     }
  635.     return(file);
  636. }
  637.  
  638. int suffix_swap(char *name)
  639. {
  640.     char *sfix;
  641.     char *fname,tmpname[64];
  642.     int len = strlen(name);
  643.  
  644.     sfix = &name[len];
  645.  
  646.     do
  647.     {
  648.         if(--sfix == name)
  649.             return 0;
  650.     }
  651.     while(*sfix != '.');
  652.     sfix++;
  653.  
  654.     len = strlen(sfix);
  655. /* just do pl and pm suffixes at the moment */
  656.     if(len == 2)
  657.     {
  658.         tolower(sfix[0]);
  659.         tolower(sfix[1]);
  660.         if(sfix[0] == 'p' && (sfix[1] == 'l' || sfix[1] == 'm'))
  661.         {
  662.             fname = sfix - 2;
  663.             while(*fname != '.' && fname-- != name);
  664.             fname++;
  665.             sprintf(tmpname,".%s",fname);
  666.             tmpname[strlen(fname)-len] = '\0';
  667.             strcpy(fname,sfix);
  668.             strcat(fname,tmpname);
  669.         }
  670.     }
  671. }
  672.